perm filename CREDPY.FAI[XGP,BGB] blob
sn#046325 filedate 1973-06-04 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00025 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE III
C00006 00003 DPYBIG: MOVE 1,ARG1
C00009 00004 DPYSTR: MOVE 3,ARG1
C00011 00005 CLIPER - 2D LINE SEGMENT CLIPPER - AUGUST 1972.
C00013 00006 SUBR(AI)----------------------------------------------------------
C00015 00007 SUBR(GETXY,VERTEX)------------------------------------------------
C00018 00008 SUBR(CLIP)
C00021 00009 XY-CLIPPER continued.
C00023 00010 SUBR(STADPY)------------------------------------------------------
C00026 00011 SUBR(DPYIMG)------------------------------------------------------
C00029 00012 SUBR(DPYGRID)-----------------------------------------------------
C00033 00013 SUBR(DECDPY)------------------------------------------------------
C00035 00014 NSUBR(DPYREAL,VAL,DECPTS)
C00036 00015 SUBR(DPYBLK)------------------------------------------------------
C00038 00016 DISPLAY CONTENTS OF THE FIRST THREE WORDS OF THE NODE.
C00041 00017 LIGHT UP THE QBLK WHEN IT IS A VERTEX OR A POLYGON.
C00043 00018 SUBR DPYHIS------------------------------------------------------
C00046 00019 SUBR(DPYGON,PGON)
C00048 00020 SUBR(DPYPAK)
C00049 00021 NSUBR DPYSGS,SEG0
C00051 00022 NSUBR(INCDPY,VERTEX)
C00052 00023 NSUBR DPYPDL
C00053 00024 NSUBR ZIPDPY
C00054 00025 OLDRC:-1
C00055 ENDMK
C⊗;
TITLE III
; -- DISPLAY SUBROUTINES -- NOVEMBER 1972.
;DISPLAY UUO CODES.
OPDEF DPYPOS [XWD 702100,0]
OPDEF DPYSIZ [XWD 702140,0]
OPDEF DPYCLR [XWD 701000,0]
OPDEF UPG [XWD 703000,0]
OPDEF GETLIN [TTYUUO 6,]
DEFINE PDPY(A,Q){PED A,Q}↔DEFINE PDPY.(A,Q){PED. A,Q}
EXTERNAL ROW0
A←1↔B←2↔C←3↔D←4
$←400000
↓YORG ←← -=280 ;CHANGE IN DPYSTA ALSO
RV←←6
AVCO←←106
VIS←←0
EP←←20
INV←←40
SVS←←100
SV←←2
INTERNAL SX,SY,DEL,MAG,DPYBUF,QBLK
INTERNAL DPYOUT,DPYSET,AIVECT,AVECT,RIVECT,RVECT,DTYO,DPYSTR,DPYBIG,DPYBRT
EXTERNAL FLGWED,BLKCNT,ARCWID,FTVSIX,NOGRID,VCUT,HISTO,FILM,UPDCON,HISTOG
EXTERNAL FLGRAR,FLGUPD,NODPY,FLGKIN,ORTHCON,DELPP,LIMITS
DPYBUF: DPYBU.
=4096↔1↔XWD 1,=4096
DPYBU.: BLOCK 10000
;SOURCE WINDOW.
SX: 0
SY: 0
SOX: 0
SOY: 0
;OBJECT WINDOW.
OX: 0
OY: 0
MAG: 3.4
DEL: 32.0
;PSEUDO BEAM POSITION.
XXX: 0
YYY: 0
DECLARE{XL,XH,YL,YH}
IGNORE: 0
DPYPTR: 0
BUFEND: 0
BUFHD: 0
NOTUPG: 0
0
DPYBIG: MOVE 1,ARG1
MOVEI 3,INV+RV ;ZERO LENGTH RELATIVE-INVISIBLE VECTOR
DPB 1,[POINT 3,3,27]
PUSH P,(P) ;COPY PC.
GO LV2
DPYBRT: MOVE 1,ARG1
MOVEI 3,INV+RV
DPB 1,[POINT 3,3,24]
PUSH P,(P) ;COPY PC.
GO LV2
RIVECT: SKIPA C,[INV+RV]
RVECT: MOVEI C,VIS+RV
GO LV
AIVECT: SKIPA C,[INV+AVCO]
AVECT: MOVEI C,VIS+AVCO
LV: MOVE A,ARG2↔MOVE B,ARG1
LVC: DPB A,[POINT 11,C,10]
DPB B,[POINT 11,C,21]
SKIPGE IGNORE↔POP2J
LV2: AOS A,DPYPTR
MOVEM C,(A)
LV3: HRLI A,<(<POINT 7,0,35>)>
MOVEM A,DPYPTR
MOVEI A,(A)
CAML A,BUFEND
SETOM IGNORE
POP2J
DPYSTR: MOVE 3,ARG1
HRLI 3,440700
DPYST1: ILDB 3↔JUMPE POP1J.
CALL(DTYO,0)↔GO DPYST1
DTYO: MOVE 1,ARG1
SKIPE IGNORE
POP1J
IDPB A,DPYPTR
HRRZ A,DPYPTR
CAML A,BUFEND
SETOM IGNORE
POP1J
DPYCLR: SKIPL DPYFLG#
DPYCLR
SETZM BUFHD
POPJ P,
DPYOUT: SKIPN 1,BUFHD↔GO .+6
MOVE 2,DPYPTR↔MOVEM 2,-2(1)
MOVEI 2,2(2)↔SUB 2,1↔MOVEM 2,-1(1)
HRRZ B,DPYPTR
SUB B,BUFHD
ADDI B,1
MOVEM B,BUFHD+1
SKIPE IGNORE
OUTSTR[ASCIZ/TVFONT dpy buffer overflow.
/]↔ MOVE 1,ARG1
DPB A,[POINT 4,.+3,12]↔IOR A,DPYFLG↔SKIPL A↔UPG BUFHD
POP1J
DPYSET: SETZM DPYFLG
MOVE 1,ARG1
ADDI 1,2
MOVEM 1,BUFHD
HRRZ 2,-3(1) ;SIZE
ADDI 2,-3(1)
SUBI 2,1
SETZM IGNORE
MOVEM 2,BUFEND
CLR2: MOVE A,BUFHD
MOVEI B,1
MOVEM B,1(A)
MOVEI B,2(A)
HRLI B,1(A)
BLT B,@BUFEND ;SET DPY BUFFER TO NULL CHARACTER WORDS
PUSH P,(P) ;COPY PC.
GO LV3
;CLIPER - 2D LINE SEGMENT CLIPPER - AUGUST 1972.
SUBR(CROP)--------------------------------------------------------
BEGIN CLIPIN
MOVE 1,OX↔MOVE MAG↔FMP SX↔FSB 1,0↔MOVEM 1,SOX
MOVE 1,OY↔MOVE MAG↔FMP SY↔FSB 1,0↔MOVEM 1,SOY
MOVE 1,OX↔MOVE MAG↔FMP[155.0]↔FSB 1,0
CAMG 1,[-510.0]↔MOVE 1,[-510.0]↔MOVEM 1,XL
MOVE 1,OX↔MOVE MAG↔FMP[155.0]↔FAD 1,0
CAML 1,[ 510.0]↔MOVE 1,[510.0]↔MOVEM 1,XH
MOVE 1,OY↔MOVE MAG↔FMP[115.0]↔FSB 1,0
CAMG 1,[-470.0]↔MOVE 1,[-470.0]↔MOVEM 1,YL
MOVE 1,OY↔MOVE MAG↔FMP[115.0]↔FAD 1,0
CAML 1,[ 470.0]↔MOVE 1,[470.0]↔MOVEM 1,YH
POP0J
BEND;12/20/72-----------------------------------------------------
SUBR(AI)----------------------------------------------------------
BEGIN AI
MOVE ARG2↔FMP MAG↔FAD SOX↔MOVEM XXX
MOVE ARG1↔FMP MAG↔FAD SOY↔MOVEM YYY
SETZM AIVFLG
POP2J
BEND;12/20/72-----------------------------------------------------
AIVFLG:0
SUBR(AV)----------------------------------------------------------
BEGIN AV
MOVE XXX↔MOVEM X1
MOVE YYY↔MOVEM Y1
MOVE ARG2↔FMP MAG↔FAD SOX↔MOVEM XXX↔MOVEM X2
MOVE ARG1↔FMP MAG↔FAD SOY↔MOVEM YYY↔MOVEM Y2
CALL(CLIP,X1,Y1,X2,Y2)
JUMPE 1,[SETZM AIVFLG↔POP2J]
CAIN 1,1↔GO[
SKIPN AIVFLG↔GO[
SETOM AIVFLG↔GO L1+1]↔GO L2]
L1: SETZM AIVFLG
FIXX 6,↔FIXX 7,↔CALL(AIVECT,6,7)
L2: FIXX 8,↔FIXX 9,↔CALL(AVECT,8,9)
POP2J
DECLARE{X1,Y1,X2,Y2}
BEND;12/20/72-----------------------------------------------------
SUBR(GETXY,VERTEX)------------------------------------------------
BEGIN GETXY; GET DISPLAY COORDINATES FROM ROW-COL COORDINATES.
;RETURN VALUES IN STACK.
;COLUMN INTO X-COORDINATE.
MOVE 1,ARG1
PUSH P,(P) ;COPY PC.
TEST 1,VBIT
GO [ OUTSTR[ASCIZ/NOT A VECTEX AT GETXY.
/]↔ SETZM ARG1↔SETZM ARG2↔POP0J ]
COL 0,1
SKIPN FLGKINK↔GO .+3↔ADDI 40↔ANDCMI 77 ;NO DEKINK.
SUBI =144*=64↔FSC 225↔MOVEM 0,ARG2 ;DPY X.
;ROW INTO Y-COORDINATE.
ROW 2,1
SKIPN FLGKINK↔GO .+3↔ADDI 2,40↔ANDCMI 2,77 ;NO DEKINK.
MOVEI =108*=64↔SUB 0,2↔FSC 225↔MOVEM 0,ARG1 ;DPY Y.
POP0J
BEND;1/4/73-------------------------------------------------------
NSUBR(RCXY,IIIX,IIIY);CONVERT DISPLAY CO-ORDINATES TO ROW-COL COORDINATES
X←1
Y←2
MOVE X,IIIX↔SUB X,SOX↔ASH X,6
MOVE 3,MAG↔FIXX 3,↔IDIV X,3
ADDI X,=144*=64
MOVE Y,IIIY↔SUB Y,SOY↔ASH Y,6
MOVE 3,MAG↔FIXX 3,↔IDIV Y,3
ADDI Y,=108*=64
POP2J
SUBREND
NSUBR(LIGHTP,OBJ)
ACCUMULATORS{X,Y}
EXTERNAL RDCUR,SETCUR,CLRCUR
MOVE X,OBJ
TEST X,VBIT+PBIT+LBIT+IBIT+FILBIT
GO [ FATAL(UNKNOWN NODE AT LIGHTP) ]
L1: TEST X,VBIT
GO [ SON X,X
GO L1 ]
CALL(GETXY,X)
POP P,Y↔FMPR Y,MAG↔FAD Y,SOY↔FIXX Y,
POP P,X↔FMPR X,MAG↔FAD X,SOX↔FIXX X,
JSA 16,SETCUR↔X↔Y↔[0]
SNEAKW
JSA 16,RDCUR↔X↔Y
JSA 16,CLRCUR
CALL(RCXY,X,Y)
POP1J
SUBREND LIGHTP;1-MAR-73(TVR)
;SUBR(CLIP)
DECLARE{AAA,BBB,CCC,FLGO,FLGZ,AXH,AXL,BYH,BYL,QNE,QNW,QSW,QSE}
SUBR(CLIP)--------------------------------------------------------
; FLG ← CLIP(X1,Y1,X2,Y2) RETURN TRUE WHEN PORTION IS VISIBLE.
BEGIN CLIP
ACCUMULATORS{X1,Y1,X2,Y2,PDL}
PTR←13
;PICK 'EM UP;
MOVE X1,ARG4↔MOVE Y1,ARG3
MOVE X2,ARG2↔MOVE Y2,ARG1
MOVEI PTR,PDL-1
;SET NSEW BITS.
SETZB 1
CAMLE Y1,YH↔TRO 8↔CAMLE Y2,YH↔TRO 1,8; NORTH.
CAMGE Y1,YL↔TRO 4↔CAMGE Y2,YL↔TRO 1,4; SOUTH.
CAMLE X1,XH↔TRO 2↔CAMLE X2,XH↔TRO 1,2; EAST.
CAMGE X1,XL↔TRO 1↔CAMGE X2,XL↔TRO 1,1; WEST.
;EASY OUTSIDER EDGE.
TRNE 0,(1)↔GO [OUTSIDE: SETZ 1,↔POP4J]
;EASY INSIDER VERTICES.
JUMPE 0,[PUSH PTR,X1↔PUSH PTR,Y1↔GO .+1]
JUMPE 1,[PUSH PTR,X2↔PUSH PTR,Y2↔GO .+1]
DEFINE DONE{CAMN PTR,[XWD 4,PDL+3]↔GO L}
CAMN PTR,[XWD 4,PDL+3]↔GO[MOVEI 1,1↔GO L+1]
;COMPUTE EDGE COEFFICIENTS.
MOVE Y1↔FSBR Y2↔MOVEM AAA
MOVE X2↔FSBR X1↔MOVEM BBB
MOVE X2↔FMPR Y1↔MOVNM CCC
MOVE X1↔FMPR Y2↔FADRM CCC
;PARTIAL PRODUCTS.
MOVE AAA↔FMPR XH↔MOVEM AXH
MOVE AAA↔FMPR XL↔MOVEM AXL
MOVE BBB↔FMPR YH↔MOVEM BYH
MOVE BBB↔FMPR YL↔MOVEM BYL
;CORNER Q'S.
SETOM FLGO↔SETZM FLGZ
MOVE AXH↔FADR BYH↔FADR CCC↔MOVEM QNE↔ANDM FLGO↔IORM FLGZ
MOVE AXL↔FADR BYH↔FADR CCC↔MOVEM QNW↔ANDM FLGO↔IORM FLGZ
MOVE AXL↔FADR BYL↔FADR CCC↔MOVEM QSW↔ANDM FLGO↔IORM FLGZ
MOVE AXH↔FADR BYL↔FADR CCC↔MOVEM QSE↔ANDM FLGO↔IORM FLGZ
;HARD OUTSIDER CASES.
SKIPGE FLGO↔GO OUTSIDE
SKIPL FLGZ↔GO OUTSIDE
;XY-CLIPPER continued.
;NORTH BORDER CROSSING.
MOVE QNE↔XOR QNW↔SKIPL↔GO L2
MOVE Y1↔CAMGE Y2↔MOVE Y2↔CAMG YH↔GO L2
MOVE BYH↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
MOVE YH↔PUSH PTR,
DONE
;SOUTH BORDER CROSSING.
L2: MOVE QSE↔XOR QSW↔SKIPL↔GO L3
MOVE Y1↔CAMLE Y2↔MOVE Y2↔CAML YL↔GO L3
MOVE BYL↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
MOVE YL↔PUSH PTR,
DONE
;EAST BORDER CROSSING.
L3: MOVE QSE↔XOR QNE↔SKIPL↔GO L4
MOVE X1↔CAMGE X2↔MOVE X2↔CAMG XH↔GO L4
MOVE XH↔PUSH PTR,
MOVE AXH↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
DONE
;WEST BORDER CROSSING.
L4: MOVE QSW↔XOR QNW↔SKIPL↔GO L5
MOVE X1↔CAMLE X2↔MOVE X2↔CAML XL↔GO L5
MOVE XL↔PUSH PTR,
MOVE AXL↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
DONE
;STRANGE EXIT - NSEW BIT MARKING & EDGE COEF ARE INCONSISTENT.
L5: OUTSTR[ASCIZ/2D CLIPPER FALL THRU !
/]↔ GO OUTSIDER
;VISIBLE PORTION EXIT.
L: SETO 1,
POP4J
LIT
BEND;12/20/72-----------------------------------------------------
SUBR(STADPY)------------------------------------------------------
BEGIN STADPY; STATUS DISPLAY - BGB - 21 JAN 1973.
EXTERNAL JOBHRL
CALL(DPYSET,DPYBUF)
CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
SKIPN JOBHRL↔GO L1
CALL(AIVECT,[=150],[=502])
CALL(DPYSTR,[[ASCIZ/SEGSIZ/]])
CALL(AIVECT,[=170],[=477])
MOVE 1,JOBHRL↔ADDI 1,1
ANDCMI 1,401777↔ASH 1,-12
CALL(DECDPY)↔CALL(DTYO,["K"])
L1: CALL(AIVECT,[=240],[=502])
CALL(DPYSTR,[[ASCIZ/NODES/]])
CALL(AIVECT,[=240],[=477])
MOVE 1,@BLKCNT↔CALL(DECDPY)
CALL(AIVECT,[=320],[=502])
CALL(DPYSTR,[[ASCIZ/LEVEL/]])
CALL(AIVECT,[=330],[=477])
SETZ 10,↔MOVE 1,FILM
SON 1,1↔JUMPE 1,.+5
SON 1,1↔JUMPE 1,.+3
CW 1,1↔NCNT 10,1↔CALL(OD)
CALL(AIVECT,[=410],[=502])
CALL(DPYSTR,[[ASCIZ/CLOCK/]])
CALL(AIVECT,[=410],[=477])
TIMER 1,↔IDIVI 1,=3600↔IDIVI 1,=60
PUSH P,2↔CALL(DECDPY)↔CALL(DPYSTR,[[ASCIZ/:/]])
POP P,1↔MOVEI 3,2
CALL(DECFOO)
CALL(AIVECT,[=280],[YORG -=210])
CALL(DPYSTR,[[ASCIZ/DELTA = /]])
CALL(DPYREAL,DEL,[2])
CALL(AIVECT,[=280],[YORG -=230])
CALL(DPYSTR,[[ASCIZ/ARCWIDTH = /]])
CALL(DPYREAL,ARCWIDTH,[3])
CALL(AIVECT,[=100],[YORG -=210])
CALL(DPYSTR,[[ASCIZ/ORTHCON = /]])
MOVE 1,ORTHCON↔FLO 1,
CALL(DPYREAL,1,[2])
CALL(AIVECT,[=100],[YORG -=230])
CALL(DPYSTR,[[ASCIZ/KINKCON = /]])
HRRE 1,DELPP↔CALL(DECDPY)
CALL(DPYOUT,[10])
POP0J
BEND STADPY;1/21/73------------------------------------------------
SUBR(DPYIMG)------------------------------------------------------
BEGIN DPYIMG; - DISPLAY 1ST IMAGE OF THE FILM - BGB - 4 DEC 1972.
SKIPE NODPY
POP0J
CALL(STADPY)
INSKIP
GO DODPY
SOSL FLGUPD
POP0J
MOVE UPDCON
MOVEM FLGUPD
DODPY: CALL(DPYGRID)
CALL(DPYBLK)
;SQUARE FRAME.
CALL(DPYSET,DPYBUF)
CALL(AIVECT,[-=510],[-=470])
CALL(AVECT,[ =510],[-=470])
CALL(AVECT,[ =510],[ =470])
CALL(AVECT,[-=510],[ =470])
CALL(AVECT,[-=510],[-=470])
;DISPLAY WHAT EVER IS IN QBLK IF POSSIBLE
SKIPE 1,QBLK↔GO[ FOO: TESTZ 1,FBIT↔GO .+1
TLNE 0,IBIT↔GO L0A
TLNN 0,IBIT+LBIT+PBIT
GO [ TLNN 0,VBIT↔GO .+1
PGON 1,1↔GO FOO ]
DAD 1,1↔GO FOO ]
;LOOP THE LEVELS, LOOP THE POLYGONS.
SETZM NOTUPG
MOVE 1,FILM
MARK 1,FILBIT↔SON 1,1↔JUMPE 1,L2 ;FIRST IMAGE.
SKIPE FLGWED↔GO L3
;CONTOUR DISPLAYS.
L0A: SON 1,1↔MOVEM 1,LEV0#↔MOVEM 1,LEV1# ;FIRST LEVEL.
L0: MOVE 1,LEV1↔HRRZ 1,(1)↔MOVEM 1,LEV1 ;HRRZ-LEVEL-RING.
SON 1,1↔JUMPE 1,L1A
MOVEM 1,PGN0#↔MOVEM 1,PGN1# ;FIRST POLYGON.
L1: MOVE 1,PGN1↔HRRZ 1,(1)↔MOVEM 1,PGN1 ;HRRZ-POLY-RING.
CALL(DPYGON,1)
MOVE 1,PGN1↔CAME 1,PGN0↔GO L1 ;POLY-RING-END.
L1A: MOVE 1,LEV1↔CAME 1,LEV0↔GO L0 ;LEVEL-RING-END.
CALL(LIMITS,LEV0)↔JUMPE 3,L2
MOVEM 3,HEIGHT#↔MOVEM 4,DEPTH#
; CALL(AIVECT,[=-120],[YORG -=210])
; CALL(DPYSTR,[[ASCIZ/HEIGHT = /]])
MOVEI 1,=108*=64↔SUB 1,HEIGHT↔FLO 1,
; CALL(DPYREAL,1,[2])
; CALL(AIVECT,[=-120],[YORG -=230])
; CALL(DPYSTR,[[ASCIZ/DEPTH = /]])
MOVE 1,DEPTH↔SUBI 1,=108*=64↔FLO 1,
; CALL(DPYREAL,1,[2])
L2: CALL(DPYOUT,[0])
POP0J ;EXIT.
;WINGED EDGE DISPLAY.
L3: PED 1,1↔MOVEM 1,E0#↔SETOM OLDRC ;FIRST EDGE.
L4:
PED 1,1
CAME 1,E0↔GO L4
GO L2
BEND;1/4/73-------------------------------------------------------
SUBR(DPYGRID)-----------------------------------------------------
BEGIN DPYGRID
CALL(DPYSET,DPYBUF)
SKIPE NOGRID↔GO L
MOVE MAG↔CAMG [34.0]↔FMPRI (10.0)
CAMG [34.0]↔FMPRI (5.0)
CAMLE [34.0]↔SKIPE FLGKINK↔GO L
MOVEM GRDINC
CALL(DPYBRT,[1])
MOVE 10,SOX↔FADR 10,GRDINC↔CAMG 10,XL↔GO .-2
FSB 10,GRDINC↔CAML 10,XL↔GO .-2↔FAD 10,GRDINC
MOVE 6,YL↔FIXX 6,↔MOVE 7,YH↔FIXX 7,
VLINES: MOVE 5,10↔FIXX 5,
CALL(AIVECT,5,6)↔CALL(AVECT,5,7)
FAD 10,GRDINC↔CAMGE 10,XH↔GO VLINES
MOVE 10,SOY↔FADR 10,GRDINC↔CAMG 10,YL↔GO .-2
FSB 10,GRDINC↔CAML 10,YL↔GO .-2↔FAD 10,GRDINC
MOVE 6,XL↔FIXX 6,↔MOVE 7,XH↔FIXX 7,
HLINES: MOVE 5,10↔FIXX 5,
CALL(AIVECT,6,5)↔CALL(AVECT,7,5)
FAD 10,GRDINC↔CAMGE 10,YH↔GO HLINES
CALL(AIVECT,[=280],[YORG -=250])
CALL(DPYSTR,[[ASCIZ/GRID = /]])
MOVE GRDINC↔FDVR MAG
CALL(DPYREAL,0,[1])
CALL(DPYSTR,[[ASCIZ/ PIXELS/]])
L: CALL(DPYOUT,[3])
POP0J
BEND;12/14/72-----------------------------------------------------
GRDINC: 0
SUBR(ID)----------------------------------------------------------
BEGIN ID;IDENT DISPLAY - BGB - 13 DEC 1972.
JUMPE 10,[
CALL(DPYSTR,[[ASCIZ/NIL /]])↔AOS(P)↔POP0J]
MOVEI 2,"U"
FOR @' Eε{VEFPLI}{
TESTZ 10,E'BIT↔MOVEI 2,"E"}
TESTZ 10,FILBIT↔MOVEI 2,"F"
TESTZ 10,ARCBIT↔MOVEI 2,"A"
SETCM 0,2(10)↔TLNN 0,(EBIT+ARCBIT)↔MOVEI 2,"S"
CALL(DTYO,2)
MOVEI 7,6↔DIPZ 10,10
JFFO 10,.+1↔CAIL 11,3↔GO[
ROT 10,3↔SUBI 11,3↔SOJA 7,.-1]↔HLLZS 10
L: ROT 10,3↔ADDI 10,60
CALL(DTYO,10)↔HLLZS 10↔SOJG 7,L
CALL(DTYO,[" "])
AOS(P)↔POP0J
BEND;12/13/72-----------------------------------------------------
SUBR(OD)----------------------------------------------------------
BEGIN OD;OCTAL HALF WORD DISPLAY - BGB - 13 DEC 1972.
JUMPE 10,[CALL(DPYSTR,[[ASCIZ/--- /]])↔POP0J]
MOVEI 7,6↔DIPZ 10,10↔SETO
L: ROT 10,3↔ADDI 10,60↔TRNE 10,17↔SETZ
JUMPN 0,.+3↔CALL(DTYO,10)↔HLLZS 10↔SOJG 7,L
CALL(DTYO,[" "])↔POP0J
BEND;12/13/72-----------------------------------------------------
SUBR(DECDPY)------------------------------------------------------
BEGIN DECDPY;DECIMAL NUMBER DISPLAY - BGB - 17 DEC 1972.
L: JUMPGE 1,.+5
MOVM 2,1
CALL(DTYO,["-"])
MOVE 1,2
IDIVI 1,12
PUSH P,2
SKIPE 1
PUSHJ P,L
POP P,1↔ADDI 1,60
CALL(DTYO,1)
POP0J
BEND;12/17/72-----------------------------------------------------
SUBR(BLKTYPE)BLK--------------------------------------------------
BEGIN BLKTYPE; CONVERT BLOCK TYPE FROM UNARY TO BINARY.
;BGB - 31 DECEMBER 1972.
MOVE 1,ARG1
TYPE 1,1
ANDI 1,177
CAIL 1,020↔GO L
JUMPE 1,POP1J.
;CAIN 1,000↔MOVEI 1,0 ;EMPTY.
;CAIN 1,001↔MOVEI 1,1 ;VERTEX.
;CAIN 1,002↔MOVEI 1,2 ;EDGE.
CAIN 1,004↔MOVEI 1,3 ;FACE.
CAIN 1,010↔MOVEI 1,4 ;POLYGON.
POP1J↔L:CAIN 1,020↔MOVEI 1,5 ;LEVEL.
CAIN 1,040↔MOVEI 1,6 ;IMAGE.
CAIN 1,100↔MOVEI 1,7 ;FILM.
POP1J
BEND;12/31/72-----------------------------------------------------
NSUBR(DPYREAL,VAL,DECPTS)
MOVE 1,VAL
FIXX 1,
CALL(DECDPY)
SKIPN DECPTS
POP2J
CALL(DTYO,["."])
MOVE 0,DECPTS
MOVSI 1,(<1.0>)
FMPRI 1,(<10.0>)
SOJG 0,.-1
MOVM 0,VAL
FMPR 0,1
FADRI 0,(<0.5>)
FIXX 0,
FIXX 1,
IDIV 0,1
MOVE 3,DECPTS
CALL(DECFOO)
POP2J
SUBREND DPYREAL
NSUBR(DECFOO)
IDIVI 1,=10
PUSH P,2
SOSLE 3
PUSHJ P,DECFOO
POP P,1
ADDI 1,60
CALL(DTYO,1)
POP0J
SUBREND DECFOO
SUBR(DPYBLK)------------------------------------------------------
BEGIN DPYBLK; DISPLAY CONTENTS OF A BLOCK - BGB - 13 DEC 1972.
CALL(DPYSET,DPYBUF)
;DISPLAY BLOCK TYPE LABEL.
CALL(DPYPDL)
SKIPN 15,QBLK↔GO L2
CALL(AIVECT,[=320],[YORG-0])
SETCM 0,2(15) ;IF BOTH ARCBIT AND EBIT ARE ON, IT'S A SEGMENT!
TLNN 0,(ARCBIT+EBIT)
GO [ MOVEI [ASCIZ/SEGMENT/]↔MOVEI 16,2↔GO L0]
TLNN 0,(ARCBIT+VBIT)
GO [ MOVEI [ASCIZ/ARC/]↔MOVEI 16,1↔GO L0]
TLNN 0,(HOLBIT+PBIT)
GO [ MOVEI [ASCIZ/POLYGON/]↔MOVEI 16,4↔GO L0]
SETQ(16,{BLKTYPE,QBLK})
MOVE[
[ASCIZ/EMPTY/] ↔ [ASCIZ/VERTEX/]
[ASCIZ/EDGE/] ↔ [ASCIZ/FACE/]
[ASCIZ/HOLE/] ↔ [ASCIZ/LEVEL/]
[ASCIZ/IMAGE/] ↔ [ASCIZ/FILM/] ](16)
L0: CALL(DPYSTR,0)
L1: CALL(DTYO,["-"])↔MOVE 10,15↔CALL(ID)↔JFCL
; DISPLAY CONTENTS OF THE FIRST THREE WORDS OF THE NODE.
RELOC 14,15 ;GET RELLOCATION BITS.
TRNE 14,$↔MOVEI 14,333333 ;EDGE CHEAT.
CALL(AIVECT,[=280],[YORG-=40])
CALL(DPYSTR,{[[ASCIZ/,. 0 /]]})
HLRZ 10,0(15)↔TRNE 14,200000↔CALL(ID)↔CALL(OD)
HRRZ 10,0(15)↔TRNE 14,100000↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG-=60])
CALL(DPYSTR,{[[ASCIZ/<> 1 /]]})
HLRZ 10,1(15)↔TRNE 14,20000↔CALL(ID)↔CALL(OD)
HRRZ 10,1(15)↔TRNE 14,10000↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG -=80])
CALL(DPYSTR,{[[ASCIZ/ 2 /]]})
HLRZ 10,2(15)↔CALL(OD)
HRRZ 10,2(15)↔CALL(OD)
;DISPLAY CONTENTS OF THE LAST THREE WORDS OF THE NODE.
CALL(AIVECT,[=280],[YORG -=120])
CALL(DPYSTR,{[[ASCIZ/∪∩ 3 /]]})
HLRZ 10,3(15)↔TRNE 14,2000↔CALL(ID)↔CALL(OD)
HRRZ 10,3(15)↔TRNE 14,1000↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG -=140])
CALL(DPYSTR,{[[ASCIZ/≤≥ 4 /]]})
HLRZ 10,4(15)↔TRNE 14,200↔CALL(ID)↔CALL(OD)
HRRZ 10,4(15)↔TRNE 14,100↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG -=160])
CALL(DPYSTR,{[[ASCIZ/⊂⊃ 5 /]]})
HLRZ 10,5(15)↔TRNE 14,20↔CALL(ID)↔CALL(OD)
HRRZ 10,5(15)↔TRNE 14,10↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG -=180])
CALL(DPYSTR,{[[ASCIZ/∨∧ 6 /]]})
HLRZ 10,6(15)↔TRNE 14,2↔CALL(ID)↔CALL(OD)
HRRZ 10,6(15)↔TRNE 14,1↔CALL(ID)↔CALL(OD)
; LIGHT UP THE QBLK WHEN IT IS A VERTEX OR A POLYGON.
; 0 = EMPTY. 4 = POLYGON.
; 1 = VERTEX. 5 = LEVEL.
; 2 = EDGE. 6 = IMAGE.
; 3 = FACE. 7 = FILM.
CAIN 16,2↔GO[TESTZ 15,ARCBIT↔GO[CALL(SEGFOO,15)↔GO L2]
CALL(DPYBRT,[5])
SETOM OLDRC
GO L2]
CAIN 16,4↔GO[CALL(DPYBRT,[5])
SETOM NOTUPG
CALL(DPYGON,15)
SETZM NOTUPG
GO L2]
CAIN 16,1↔GO[CALL(DPYBRT,[7])
CALL(GETXY,15)↔CALL(AI)
MOVE 1,XXX↔FIXX 1,↔SUBI 1,2
MOVE 2,YYY↔FIXX 2,↔SUBI 2,2
CALL(AIVECT,1,2)
TESTZ 15,ARCBIT↔GO[CALL(DTYO,["A"])↔GO C1]
CALL(DTYO,["V"])
C1: CCW 1,15
CALL(GETXY,1)↔CALL(AV)
GO L2]
L2: CALL(DPYOUT,[1])↔POP0J
BEND;1/25/73------------------------------------------------------
NSUBR(SEENODE,OBJ)
PUSHACS
MOVE 1,OBJ
EXCH 1,QBLK
PUSHP 1
CALL(DPYBLK)
POPP QBLK
POPACS
POP1J
SUBREND SEENODE;1-MAR-73(TVR)
QBLK: 0
SUBR DPYHIS;------------------------------------------------------
BEGIN DPYHIS;(PGON) - DISPLAY HISTOGRAM - BGB - 8 DEC 1972.
X←←10 ↔ Y←←11 ↔ CNT←←14
CALL(HISTOG)
CALL(DPYSET,DPYBUF)
CALL(DPYBIG,[1])
;SCALE THE IMAGE TO ITS LARGEST COLUMN.
SETZ↔HRLZI 1,-77
CAMGE 0,HISTO(1)↔MOVE HISTO(1)↔AOBJN 1,.-2
MOVE 1,[800.0]↔FSC 233↔FDV 1,0↔MOVEM 1,SY#
;INITIALIZE HISTO LOOP.
SETZ CNT,
HRREI X,=511↔HRREI Y,-=404
CALL(AIVECT,X,Y)↔MOVNS X
CALL(AVECT,X,Y)
L1: SKIPN FTVSIX↔GO[TRNE CNT,3↔GO L2↔GO .+1]
MOVE Y,HISTO(CNT)↔FSC Y,233↔FMP Y,SY↔FIXX Y,
SUBI Y,=400
L2: CALL(AVECT,X,Y)
TRNE CNT,3↔GO L3
;INTENSITY LEVEL NUMERAL.
HRREI 0,-=440↔SUBI X,10↔CALL(AIVECT,X,0)
MOVE CNT↔LSHC -3↔SKIPE↔IORI "0"↔IORI " "
LSH 4↔LSHC 3
IORI "0"↔ROT 0,-16↔IORI 1
AOS 1,DPYPTR↔MOVEM(1)
;PEC CENT AT THIS LEVEL NUMERAL.
HRREI 0,-=465↔CALL(AIVECT,X,0)↔ADDI X,10
MOVE HISTO+0(CNT)↔ADD HISTO+1(CNT)
ADD HISTO+2(CNT)↔ADD HISTO+3(CNT)
IMULI =1000↔IDIVI =62208↔ADDI 5↔IDIVI =10
JUMPE L4↔IDIVI =10
ROT 1,-4
SKIPE↔IORI "0"↔IORI " "
LSH 3↔LSHC 4↔IORI "0"↔LSH 16↔IORI " %"
LSH 8↔IORI 1↔AOS 1,DPYPTR↔MOVEM(1)
L4: CALL(AIVECT,X,Y)
;ADVANCE.
L3: ADDI X,20
CALL(AVECT,X,Y)
AOS CNT↔CAIE CNT,100↔GO L1
HRREI -=400↔CALL(AVECT,X,0)
PGCLR
CALL(DPYOUT,[0])↔CRLF
DETSEG
POP0J
BEND;12/16/72-----------------------------------------------------
SUBR(DPYGON,PGON)
BEGIN DPYGON; DISPLAY POLYGON - BGB - 4 DEC 1972.
;FIRST EDGE/VERTEX ABSOLUTE INVISIBLE VECTOR.
MOVE 1,ARG1
TEST 1,PBIT
GO [ OUTSTR[ASCIZ/NOT A POLYGON AT DPYGON.
/]↔ POP1J ]
ARC 2,1↔SKIPG FLGRAR↔SON 2,1
MOVE 1,2
JUMPE 1,POP1J.
L0: MOVEM 1,E0#↔MOVEM 1,V#
MOVEI =2048↔MOVEM VLIMIT# ;TIMEOUT IF TOO MANY VECTORS!!!
CALL(GETXY,1)↔PUSHJ P,AI
;FOLLOW AROUND THE POLYGON WITH ABS VISIBLE VECTORS.
L1: MOVE 1,V↔HRRZ 1,0(1)↔MOVEM 1,V
CALL(GETXY,1)↔MOVE 1,V↔CNTRST 0,1↔MOVMS
CAMG 0,VCUT↔GO[PUSHJ P,AI↔SETO 1,↔GO .+2]↔PUSHJ P,AV
MOVE 2,V↔CAME 2,E0↔SKIPN NOTUPG↔PDPY. 1,2
L1A: MOVE 1,V↔EXO 2,1↔JUMPN 2,[
ENDO 0,2↔CAME 0,V↔GO .+1
CALL(GETXY,2)↔CALL(AV)
CALL(GETXY,V)↔CALL(AV)↔GO .+1]
MOVE 1,V
SOSGE VLIMIT↔GO [ OUTSTR[ASCIZ/TOO MANY VECTORS!!! YOU'LL PROBABLY LOSE.
/]↔ POP1J]
CAME 1,E0↔GO L1
;IS DISPLAY BOTH ENABLED.
SKIPL FLGRAR↔POP1J
MOVE 1,ARG1↔ARC 1,1↔CAME 1,E0↔JUMPN 1,L0↔POP1J
BEND;1/25/73------------------------------------------------------
SUBR(DPYPAK)
BEGIN DPYPAK;DISPLAY PAK CONTENTS.
EXTERN RMIN,RMAX,CMIN,CMAX,PAKPTR
ACCUMULATORS{R,C}
SKIPE NODPY
POP0J
INSKIP
GO DODPY
SOSL FLGUPD
POP0J
MOVE UPDCON
MOVEM FLGUPD
DODPY: CALL(DPYSET,DPYBUF)
SKIPN RMAX↔GO L3
CALL(DPYBIG,[1])
CALL(DPYBRT,[1])
CALL(AIVECT,[-=511],[=460])
MOVE R,RMIN
L1: MOVE C,CMIN↔LSH R,3
L2: LDB PAKPTR(C)
MOVEI 1,"."↔SKIPE↔MOVEI 1,"o"
CALL(DTYO,1)
AOS C↔CAMG C,CMAX↔GO L2
CALL(DTYO,[15])↔CALL(DTYO,[12])
PUSH P,R↔PUSH P,C
CALL(RIVECT,[0],[=8])
POP P,C↔POP P,R
LSH R,-3↔AOS R↔CAMG R,RMAX↔GO L1
L3: CALL(DPYOUT,[13])
POP0J
BEND
NSUBR DPYSGS,SEG0
SEG1←15
V←16
PUSHACS
CALL DPYSET,DPYBUF
CALL DPYBRT,[4]
MOVE SEG1,SEG0
JUMPE SEG1,FIN
L1: MOVEI V,DUMMY
MOVE 1,ROW0
ROW. 1,V
HRRE 1,4(SEG1) ;RCOL
COL. 1,V
CALL(GETXY,V)
CALL(AI)
HLRE 1,4(SEG1) ;LCOL
COL. 1,V
CALL(GETXY,V)
CALL(AV)
HLRZ V,6(SEG1) ;LT
CW V,V
CALL(GETXY,V)
CALL(AI)
CCW V,V
CALL(GETXY,V)
CALL(AV)
CALL(DTYO,["L"])
HRRZ V,6(SEG1) ;RT
CALL(GETXY,V)
CALL(AI)
CCW V,V
CALL(GETXY,V)
CALL(AV)
CALL DTYO,["R"]
CCW SEG1,SEG1
CAME SEG1,SEG0
GO L1
FIN: CALL DPYOUT,[1] ;USE SAME AS DPYBLK
SNEAKS 1,
GO .+3
CAIN 1,"D"
GO [ CALL(POPIT)↔CALL(DDTGO)↔POP1J ]
CAIN 1," "
GO [ INCHRW 1↔SNEAKW 1,↔GO .+1]
POPACS
POP1J
DUMMY: XWD .,. ;A FAKE VERTEX
0
XWD 1,300000
BLOCK 4
INTERNAL DPYSEG
↑DPYSEG:CALL(SEENODE,SEG0)
↑SEGFOO:CALL(PUSHIT)
.PLEVEL←←.PLEVEL+20
HRRZ SEG1,SEG0
JUMPE SEG1,FIN
CCW 1,SEG1
HRRZM 1,SEG0
GO L1
SUBREND DPYSGS;
NSUBR(INCDPY,VERTEX)
CALL(PUSHIT)
.PLEVEL←←.PLEVEL+20
HRRZ 1,VERTEX
TEST 1,VBIT
GO DOALL
PDPY 10,1
SKIPE 10
CAIN 10,777777
GO [ DOALL: CALL(DPYIMG)↔GO FIN ]
CALL(GETXY,1)
CALL(AI)
MOVE 1,XXX
FIXX 1,
MOVE 2,YYY
FIXX 2,
MOVEI 3,106
DPB 1,[POINT 11,3,10]
DPB 2,[POINT 11,3,21]
PGSEL 0
UPGMVM 3,(10)
CALL(DPYBLK)
FIN: CALL(POPIT)
.PLEVEL←←.PLEVEL-20
POP1J
SUBREND INCDPY
NSUBR DPYPDL
EXTERNAL DATPDL,DATPTR
PDLPTR←5
HRRZ PDLPTR,DATPTR
MOVEM PDLPTR,PDLEND#
CALL(AIVECT,[=180],[-=460])
MOVEI PDLPTR,DATPDL
LOOP: CAMLE PDLPTR,PDLEND
POP0J
MOVE 10,(PDLPTR)
CALL(ID)↔CALL(OD)
CALL(DTYO,[15])
CALL(RIVECT,[1000+=180],[=20])
AOJA PDLPTR,LOOP
SUBREND DPYPDL
NSUBR ZIPDPY
ACCUMULATORS{IMG,LVL,PGN,V,IMG0,LVL0,PGN0,V0}
MOVE 1,FILM
SON IMG,1
JUMPE IMG,[POP0J]
MOVEM IMG,IMG0
SETZ 0,
ILOOP: SON LVL,IMG
JUMPE LVL,ICONT
MOVEM LVL,LVL0
LLOOP: SON PGN,LVL
JUMPE PGN,LCONT
MOVEM PGN,PGN0
PLOOP: SON V,PGN
JUMPE V,PCONT
MOVEM V,V0
VLOOP: PDPY. 0,V
CCW V,V
JUMPE V,[FATAL(DISCONNECTED VERTEX RING!)]
CAME V,V0
GO VLOOP
PCONT: CCW PGN,PGN
CAME PGN,PGN0
GO PLOOP
LCONT: CCW LVL,LVL
CAME LVL,LVL0
GO LLOOP
ICONT: CCW IMG,IMG
CAME IMG,IMG0
GO ILOOP
POP0J
SUBREND ZIPDPY
OLDRC:-1
TAIL ;ALL THOSE WONDERFUL FIXUPS!
END